Évaluation de la gaine du nerf optique par échographie dans l’Artérite à Cellules géantes

Auteur
Affiliation

Dr Philippe MICHEL

USRC - Hôpital NOVO

Évaluation de la gaine du nerf optique par échographie dans l’Artérite à Cellules géantes

Recherche non interventionnelle ne comportant aucun risque ni contrainte

Étude diagnostique non interventionnelle, prospective multicentrique

Investigateur Coordonnateur
Omar AL TABAA — Rhumatologie Hôpital NOVO (Site de Pontoise)

Comité scientifique
Maxime SANSOM — Service de médecine interne CHU Dijon
Sébastien OTTAVIANI — Service de rhumatologie hôpital Bichat (Paris)
Olivier ESPITIA — Service de médecine vasculaire CHU Nantes

Chef de projet
Mathilde WLODARCZY — USRC

Méthodologiste
Chrystelle VIDAL — GIRCI Île de France

Data-manager
Nathanaël CHARRIER — USRC

Statisticien
Philippe MICHEL — USRC

Code
#
# setup
#

library(tidyverse)
library(baseph)
library(labelled)
library(readODS)
library(janitor)
library(kableExtra)
library(gtsummary)
library(plotly)

classeur <- "petrusvalid.ods"
expx <- FALSE
if (expx) {
  file.create(classeur)
  file.remove(classeur)
  write_ods(iris, classeur)
}

# sessionInfo()

theme_gtsummary_language(language = "fr", decimal.mark = ",")
theme_gtsummary_journal(journal = "jama")
options(OutDec = ",")
ptest <- list(all_continuous() ~ "t.test", all_categorical() ~ "chisq.test")
ptest2 <- list(all_continuous() ~ "paired.t.test", all_categorical() ~ "chisq.test")
stt <- list(
  all_continuous() ~ "{mean} ({sd})",
  all_categorical() ~ "{n}/{N} ({p}%)")
Code
#
# Importation des données 
#
library(tidyverse)
library(baseph)
library(readODS)
library(labelled)
library(janitor)
#
# Concordance intra
#

nad <- c("", " ", "NA", "ND")

intra <- read_ods("datas/concordance_intra.ods", 
                  na = nad) |> 
    clean_names() |>
  mutate(across(where(is.character), as.factor))
bn <- read_ods("datas/concordance_intra.ods", 
                sheet = 2)
var_label(intra) <- bn$titre
#
# Concordance technique
#
tech <- read_ods("datas/concordance_techniques.ods", 
                  na = nad) |> 
    clean_names() |>
  mutate(across(where(is.character), as.factor))
bn <- read_ods("datas/concordance_techniques.ods", 
                sheet = 2)
var_label(tech) <- bn$titre
#
# Validation mesures
#
tt <- read_ods("datas/validation-mesures.ods", 
                  na = nad) |> 
    clean_names() |>
  mutate(across(where(is.character), as.factor))
bn <- read_ods("datas/validation-mesures.ods", 
                sheet = 2)
var_label(tt) <- bn$titre
#

Les données ne sont présentes que pour un seul des experts.

On considère qu’il y a une erreur dans les mesures si la différence entre les deux mesures est supérieure à 1 mm.

Code
#
# Préparation des données 
#
intra2 <- intra |> 
  pivot_longer(names_to = "structure", values_to = "value", cols = nerf_droit:gaine_gauche) |> 
  pivot_wider(names_from = "relecture", values_from = "value") |> 
  ## Recodage de zz$structure
mutate(structure = fct_recode(structure,
    "gaine du nerf optique" = "gaine_droit",
    "gaine du nerf optique" = "gaine_gauche",
    "nerf optique" = "nerf_droit",
    "nerf optique" = "nerf_gauche"
  )) |> 
mutate(dif = abs( R_1 - R_2)) |> 
mutate(erreur = as.factor(ifelse(dif > 0.999,"Erreur","Correct"))) |> 
  drop_na(dif) 
intra2 <- droplevels(intra2)
var_label(intra2$dif) <-  "Différence des mesures"
var_label(intra2$erreur) <-  "Erreur de mesure"
Code
tab <-intra2 |> 
dplyr::filter(structure == "nerf optique") |> 
dplyr::select(dif, erreur) |> 

 tbl_summary(missing = "no",
              type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
  add_n() |> 
  bold_labels() |>
  modify_header(label ~ " ") |> 
   modify_spanning_header(c("stat_0") ~ "**Nerf optique**") 
  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "intra-tab1n", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))
Concordance intra-observateur
Nerf optique
N N = 20
Différence des mesures 20
Moyenne ± ET 0.33 ± 0.26
Min, Max 0.01, 0.92
Erreur de mesure, n (%) 20
Correct 20 (100)
Code
intra2 |> 
dplyr::filter(structure != "nerf optique") |> 
dplyr::select( dif, erreur) |> 

tbl_summary(missing = "no",
              type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
     modify_spanning_header(c("stat_0") ~ "**Gaine du nerf optique**") |>
  add_n() |> 
  bold_labels() |>
  modify_header(label ~ " ") 
N
Gaine du nerf optique
N = 20
Différence des mesures 20
    Moyenne ± ET
0.22 ± 0.14
    Min, Max
0.01, 0.69
Erreur de mesure, n (%) 20
    Correct
20 (100)
Code
  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "intra-tab1g", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))
Concordance intra-observateur
Nerf optique
N N = 20
Différence des mesures 20
Moyenne ± ET 0.33 ± 0.26
Min, Max 0.01, 0.92
Erreur de mesure, n (%) 20
Correct 20 (100)

La concordance des deux mesures tend à valider la qualité des mesures. Les mesures semblent plus reproductibles pour la gaine du nerf optique que pour le nerf optique.

Code
intra2 |> 
  ggplot() + 
  aes(x = dif, fill = structure) |> 
  geom_density(alpha = .7) +
        labs(
      title = "Différence entre les deux mesures",
      x = "mm", 
      caption = "Différence mesure 2 / mesure 1"
    ) +
    theme_light() +
    theme(
      plot.title = element_text(size = 18, face = "bold"),
      plot.subtitle = element_text(size = 12),
      axis.title.x = element_text(size = 12),
      axis.title.y = element_blank(),
      axis.text.x = element_text(size = 12),
      axis.text.y = element_text(size = 12),
      legend.position = "top"
    )
Figure 1: Différence entre les deux mesures
Code
#| label: fig-intra2
#| fig-cap: Différence entre les deux mesures

zz <- intra2 |> 
  ggplot() + 
  aes(x = structure, y = dif, fill = structure) |> 
  geom_violin() +
        labs(
      title = "Différence entre les deux mesures",
      x = "Structure", 
      y ="mm",
      caption = "Différence mesure 2 / mesure 1"
    ) +
    theme_light() +
    theme(
      plot.title = element_text(size = 18, face = "bold"),
      plot.subtitle = element_text(size = 12),
      axis.title.x = element_text(size = 12),
      axis.title.y = element_text(size = 12),
      axis.text.x = element_text(size = 12),
      axis.text.y = element_text(size = 12),
      legend.position = "none"
    )

ggplotly(zz)

On compare ici deux méthode de mesure : technique habituelle vs mesure à l’interface du vitré.

Code
#
# Concordance technique :préparation des données
#
tech2 <- tech |> 
  pivot_longer(names_to = "structure", values_to = "value", cols = nerf_droit:gaine_gauche) |> 
  pivot_wider(names_from = "technique", values_from = "value") |> 
  mutate(structure = fct_recode(structure,
                                "gaine du nerf optique" = "gaine_droit",
                                "gaine du nerf optique" = "gaine_gauche",
                                "nerf optique" = "nerf_droit",
                                "nerf optique" = "nerf_gauche"
  )) |> 
  mutate(dif = abs(habituelle -`Interface vitré`)) |> 
  mutate(erreur = as.factor(ifelse(dif > 0.999,"Erreur","Correct"))) |> 
  drop_na(dif)
var_label(tech2$dif) <-  "Différence des mesures"
Code
cot <- rep(c("d","d","g","g"),20)

 zz <- tech2 |> 
dplyr::filter(structure == "nerf optique") |> 
mutate(id = as.factor(paste0(centre, expert,coupe))) |> 
dplyr::select(id, habituelle:`Interface vitré`) |> 
pivot_longer(cols = habituelle :`Interface vitré`)  |> 
mutate(id = paste0(id,cot)) |> 
mutate(name = as.factor(name)) |> 
drop_na() 
tab <- zz |> 
  tbl_summary(by = name, 
              include = -id,
              type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
  add_p(test = list(
          all_continuous() ~ "paired.t.test"),
        group = id) |> 
    add_n() |> 
  bold_labels() |>
  bold_p() |> 
  modify_header(label ~ "**Nerf optique**") 
  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "tab-tech1n", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))
Concordance technique
Nerf optique N habituelle
N = 95
Interface vitré
N = 95
p-valeur
value 190 &lt;0,001
Moyenne ± ET 3.43 ± 0.41 3.24 ± 0.38
Min, Max 2.30, 4.40 2.20, 4.40
1 Paired t-test
Code
zg <- tech2 |> 
dplyr::filter(structure != "nerf optique") |> 
mutate(id = as.factor(paste0(centre, expert,coupe))) |> 
dplyr::select(id, habituelle:`Interface vitré`) |> 
pivot_longer(cols = habituelle :`Interface vitré`)  |> 
mutate(id = paste0(id,cot)) |> 
mutate(name = as.factor(name)) |> 
drop_na() 
tab <- zg |> 
  tbl_summary(by = name, 
              include = -id,
              type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
  add_p(test = list(
          all_continuous() ~ "paired.t.test"),
        group = id) |> 
      add_n() |> 
  bold_labels() |>
  bold_p() |> 
  modify_header(label ~ "**Gaine du nerf optique**") 

  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "tab-tech1g", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))
Concordance technique
Gaine du nerf optique N habituelle
N = 95
Interface vitré
N = 95
p-valeur
value 190 0,27
Moyenne ± ET 4.71 ± 0.65 4.77 ± 0.55
Min, Max 3.30, 6.50 3.70, 6.20
1 Paired t-test
Code
vvn <- var.test(zz$value~zz$name, alternative ="two.sided")
vvn <- beaup(vvn$p.value, affp = 1)

vvg <- var.test(zg$value~zg$name, alternative ="two.sided")
vvg <- beaup(vvg$p.value, affp = 1)

mesure = c("Nerf optique", "Gaine du nerf optique")
pvalue <- c(vvn, vvg)
             
vv <- tibble(mesure, pvalue) 

names(vv)[2] <- "Comparaison des variances"

  if (expx) {
      vv |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "tab-echvar", append = TRUE)
    }
vv |> 
kbl() |>  
  kable_material(c("striped", "hover"))
mesure Comparaison des variances
Nerf optique p = 0,467
Gaine du nerf optique p = 0,109

Pour la mesure du nerf optique la technique à l'interface vitrée a tendance est être plus petite que la mesure habituelle. Pas de différence pour la mesure de la gaine.Mais la précision est la même, il n’y a pas de différence entre les variances des deux méthodes.

Selon l’expert

Il n’y a aucune mesure utilisable pour le Dr OTTAVIANI.

Code
tab <- tech2 |> 
  dplyr::filter(structure == "nerf optique") |> 
dplyr::filter(expert != "OTTAVIANI") |> 
mutate(expert = factor(expert)) |>
  drop_na() |>
 dplyr::select(expert,dif) |> 
  tbl_summary(by = expert,
type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
 add_p(test = list(
          all_continuous() ~ "t.test")) |> 
      add_n() |> 
  bold_labels() |>
  bold_p() |> 
  modify_header(label ~ "**Nerf optique**") 
  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "techexpn", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))
Différence des mesures entre les deux méthodes selon l'expert
Nerf optique N AL TABAA
N = 56
ESPITIA
N = 39
p-valeur
Différence des mesures 95 0,012
Moyenne ± ET 0.24 ± 0.20 0.39 ± 0.33
Min, Max 0.00, 0.98 0.00, 1.40
1 test de Student
Code
tab <- tech2 |> 
  dplyr::filter(structure != "nerf optique") |> 
dplyr::filter(expert != "OTTAVIANI") |> 
mutate(expert = factor(expert)) |>
  drop_na() |>
 dplyr::select(expert,dif) |> 
  tbl_summary(by = expert,
type = all_continuous() ~ "continuous2",
               statistic = all_continuous() ~ c(
      "{mean} ± {sd}",
      "{min}, {max}")) |> 
 add_p(test = list(
          all_continuous() ~ "t.test")) |> 
      add_n() |> 
  bold_labels() |>
  bold_p() |> 
  modify_header(label ~ "**Gaine du nerf optique**") 
  if (expx) {
      tab |>
        as_tibble() |>
        write_ods(path = classeur, sheet = "techexpg", append = TRUE)
    }
tab |> 
  as_kable_extra() |> 
   kable_material(c("striped", "hover"))
Différence des mesures entre les deux méthodes selon l'expert
Gaine du nerf optique N AL TABAA
N = 56
ESPITIA
N = 39
p-valeur
Différence des mesures 95 &lt;0,001
Moyenne ± ET 0.16 ± 0.14 0.65 ± 0.50
Min, Max 0.00, 0.63 0.00, 1.90
1 test de Student

On compare ici les mesures de chaque lecteur avec la moyenne des trois experts.

Code
exp <- tt |> 
  drop_na() |> 
  dplyr::filter(lecteur != "échographiste formé") |> 
  pivot_longer(cols = nerf_droit:gaine_gauche,values_to = "mesure") |> 
 mutate(coupe2= paste0(coupe, name)) |>  
group_by(coupe2) |> 
  summarise(round(mean(mesure),2))

lect <- tt |> 
  dplyr::filter(lecteur == "échographiste formé") |> 
    pivot_longer(cols = nerf_droit:gaine_gauche,values_to = "mesure") |> 
 mutate(coupe2= paste0(coupe, name))

el <- left_join(exp,lect, by = "coupe2") |> 
  dplyr::select(- c(coupe2, lecteur, coupe)) 

names(el) <- c("moy_exp",  "structure", "mes_lecteur")

el <- el |> 
  mutate(dif = round(abs(moy_exp - mes_lecteur),2)) |> 
  mutate(erreur = as.factor(ifelse(dif > 0.999, "Erreur", "Correct"))) |> 
mutate(structure = fct_recode(structure,
    "Gaine du nerf optique" = "gaine_droit",
    "Gaine du nerf optique" = "gaine_gauche",
    "Nerf optique" = "nerf_droit",
    "Nerf optique" = "nerf_gauche"
  )) |> 
relocate(structure, .before = moy_exp)

var_label(el) <-  c("Structure", "Moyenne des experts", "Mesure du lecteur" ,"Différence", "Validation")
Code
tab <- el |> 
mutate(dif = cell_spec(dif, color = ifelse(dif > 0.999, "red", "black"))) |> 
  mutate(erreur = cell_spec(erreur, color = ifelse(erreur =="Erreur", "red", "black"))) 
  if (expx) {
      tab |>
        write_ods(path = classeur, sheet = "vallect", append = TRUE)
    }
tab |> 
  kbl(escape = F) |>
   kable_material(c("striped", "hover"))
structure moy_exp mes_lecteur dif erreur
Gaine du nerf optique 5,68 5,56 0,12 Correct
Gaine du nerf optique 5,02 5,08 0,06 Correct
Nerf optique 3,88 3,90 0,02 Correct
Nerf optique 3,33 3,75 0,42 Correct
Gaine du nerf optique 3,96 4,20 0,24 Correct
Gaine du nerf optique 3,79 3,91 0,12 Correct
Nerf optique 2,72 3,00 0,28 Correct
Nerf optique 2,51 2,92 0,41 Correct
Gaine du nerf optique 5,07 5,46 0,39 Correct
Gaine du nerf optique 5,02 5,45 0,43 Correct
Nerf optique 3,58 3,83 0,25 Correct
Nerf optique 3,62 3,90 0,28 Correct
Gaine du nerf optique 4,51 4,49 0,02 Correct
Gaine du nerf optique 4,38 4,84 0,46 Correct
Nerf optique 3,15 3,48 0,33 Correct
Nerf optique 3,04 3,80 0,76 Correct
Gaine du nerf optique 4,30 4,41 0,11 Correct
Gaine du nerf optique 4,20 4,45 0,25 Correct
Nerf optique 2,97 3,80 0,83 Correct
Nerf optique 2,86 3,51 0,65 Correct
Gaine du nerf optique 4,62 4,62 0 Correct
Gaine du nerf optique 4,51 4,72 0,21 Correct
Nerf optique 3,00 3,51 0,51 Correct
Nerf optique 3,22 3,79 0,57 Correct
Gaine du nerf optique 4,27 4,59 0,32 Correct
Gaine du nerf optique 4,64 4,83 0,19 Correct
Nerf optique 3,24 3,74 0,5 Correct
Nerf optique 3,24 3,62 0,38 Correct
Gaine du nerf optique 4,36 4,73 0,37 Correct
Gaine du nerf optique 4,64 4,71 0,07 Correct
Nerf optique 3,04 3,51 0,47 Correct
Nerf optique 3,39 4,04 0,65 Correct
Gaine du nerf optique 4,53 4,06 0,47 Correct
Gaine du nerf optique 4,65 4,69 0,04 Correct
Nerf optique 2,43 2,73 0,3 Correct
Nerf optique 2,18 3,42 1,24 Erreur
Gaine du nerf optique 4,89 5,32 0,43 Correct
Gaine du nerf optique 4,22 5,02 0,8 Correct
Nerf optique 3,23 4,09 0,86 Correct
Nerf optique 2,99 3,47 0,48 Correct

Le lecteur testé ici a fait une erreur sur quarante mesures.